home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 019 / 123range.arc / 123RANGE.BAS
BASIC Source File  |  1984-02-25  |  8KB  |  219 lines
  1. 10    ' 123RANGE.BAS    List Lotus Range Names used in a spreadsheet file (.wks)20    '
  2. 20    ' Charles H. Greene dba ISM                           April 23, 1983
  3. 30    ' 150 West First Street                        Rev.1  May   20, 1983
  4. 40    ' New Richmond, Wi   54017     <715> 246-6690
  5. 50    '
  6. 60    ' Lotus v1.0 does not provide for listing Range Names that have been
  7. 70    ' assigned..this program provides a modest solution to that problem.
  8. 90    '
  9. 100   ' Range Name           FLD.CNT()
  10. 110   '  Specification       1...5...10....5...20....5.28
  11. 120   '                      AAAAAAAAAAAAAAABCCDDEEFFGGGG
  12. 130   '   where
  13. 140   '    A=range name            00h is used in place of space 20h
  14. 150   '    B=unknown               00h
  15. 160   '    C=begining column       low/high byte format value is 1 less
  16. 170   '    D=         row          than actual value ie.2048=FF07h
  17. 180   '    E=ending column
  18. 190   '    F=       row
  19. 200   '    G=seperators            0B 00 18 00h
  20. 210   '
  21. 220   '
  22. 1000   DEFINT A-Z
  23. 1010   DIM RANGE$(500)
  24. 1020   RCNT=0: RMAX=500
  25. 1030   BLACK=0: WHITE=7: BRIGHT=16: FG=WHITE: BG=BLACK
  26. 1040   FALSE=0: TRUE=NOT FALSE
  27. 1050   END.OF.FILE=FALSE
  28. 1060   FF$=CHR$(12)
  29. 1070   X=0: Y=0: Z=0
  30. 1080   X$=""
  31. 1090                                     'characters seperating range names
  32. 1100   LOTUS.CTL$(1)=CHR$(11)            'Range Name fields begin with this
  33. 1110   LOTUS.CTL$(2)=CHR$(0)             '  sequence of characters (1)-(4)
  34. 1120   LOTUS.CTL$(3)=CHR$(24)            'any break in this sequence ends
  35. 1130   LOTUS.CTL$(4)=CHR$(0)             '  the range names
  36. 5000  '
  37. 5010  ' Load table of column codes
  38. 5020  '
  39. 5030  DIM COL$(256)
  40. 5040  FOR X = 0 TO 255
  41. 5050     READ COL$(X)
  42. 5060  NEXT
  43. 5070  '
  44. 5080  ' Print Headings
  45. 5090  '
  46. 5100  PRINT
  47. 5110  KEY OFF: CLS: LOCATE ,,0
  48. 5120  HEAD1$="List Lotus(tm) Range Names                             123RANGE <ISM>": PRINT HEAD1$
  49. 5130  PRINT
  50. 5140  '
  51. 5150  ' Get Lotus filespec
  52. 5160  '
  53. 5170  ON ERROR GOTO 15000
  54. 5180  PRINT "Enter LOTUS spreadsheet filespec : ";
  55. 5190  INPUT "",FILE$
  56. 5200  Z=INSTR(FILE$,".")                'make sure it has .wks extension
  57. 5210  IF Z=0 THEN FILE$=FILE$+".WKS"
  58. 5220  OPEN FILE$ AS #1 LEN=1
  59. 5230  FIELD #1,1 AS X$
  60. 5240  FCB=VARPTR(#1)                    'address FCB
  61. 5250  Z=PEEK(FCB)                       'file type must be random
  62. 5260  IF Z<>4 THEN CLOSE #1: GOTO 5140
  63. 5270                   'address FCB
  64. 5250  Z=PEEK(FCB)                       'file type must be random
  65. 5260  IF Z<>4 THEN CLOSE #1: GOTO 5140
  66. 5270  RCDLIMIT!=((PEEK(FCB+19)*256)*256)+PEEK(FCB+17)+(256*PEEK(FCB+18))
  67. 5280  IF RCDLIMIT!=0 THEN CLOSE #1: PRINT: PRINT "**** File not found ****": GOTO 5140
  68. 5290  PRINT: PRINT: PRINT "File contains "RCDLIMIT!"bytes.": PRINT: PRINT
  69. 5300  HEAD2$="File: "+FILE$+SPACE$(49-LEN(FILE$))+DATE$+"  "+LEFT$(TIME$,5)
  70. 6000  '
  71. 6010  ' Process
  72. 6020  '
  73. 6030  GOSUB 8000                        'get byte
  74. 6040  FLD.CNT=1: RANGE.NAME$=""
  75. 6050  WHILE NOT END.OF.FILE
  76. 6060      ON MATCH.CNT+1 GOSUB 10000, 10060, 10100, 10140, 11000
  77. 6070      GOSUB 8000
  78. 6080  WEND
  79. 7000  '
  80. 7010  ' End of Input
  81. 7020  '
  82. 7030  PRINT: PRINT: PRINT "< END OF LIST >"
  83. 7040  PRINT: PRINT
  84. 7050  INPUT "Output to Printer (Y/N) ";ANS$
  85. 7060  IF ANS$="Y" OR ANS$="y" THEN GOSUB 16000
  86. 7070  END                               'done
  87. 8000  '
  88. 8010  ' Read file
  89. 8020  '
  90. 8030  RCDNO!=RCDNO!+1                   'set next random record(byte) no.
  91. 8040                                    'check for end of file
  92. 8050  IF RCDNO!>RCDLIMIT! THEN END.OF.FILE=TRUE: X$="": GOTO 8070
  93. 8060  GET #1,RCDNO!
  94. 8070  RETURN
  95. 10000 '
  96. 10010 ' Look for start of range names 0Bh 00h 18h 00h
  97. 10020 '
  98. 10030 IF X$<>CHR$(11) THEN MATCH.CNT = 0:RETURN
  99. 10040 MATCH.CNT=1
  100. 10050 RETURN
  101. 10060 '
  102. 10070 IF X$<>CHR$(0)  THEN MATCH.CNT = 0: GOTO 10000
  103. 10080 MATCH.CNT=2
  104. 10090 RETURN
  105. 10100 '
  106. 10110 IF X$<>CHR$(24) THEN MATCH.CNT = 0: GOTO 10000
  107. 10120 MATCH.CNT=3
  108. 10130 RETURN
  109. 10140 '
  110. 10150 IF X$<>CHR$(0)  THEN MATCH.CNT = 0: GOTO 10000
  111. 10160 MATCH.CNT=4
  112. 10170 RETURN
  113. 11000 '
  114. 11010 ' Range name fields found
  115. 11020 '
  116. 11030 IF FLD.CNT > 15 GOTO 11070
  117. 11040 IF X$<>CHR$(0) THEN RANGE.NAME$=RANGE.NAME$+X$
  118. 11050 FLD.CNT=FLD.CNT+1
  119. 11060 RETURN
  120. 11070 IF FLD.CNT > 18 GOTO 11110
  121. 11080 IF FLD.CNT = 17 THEN RANGE.BEG.COL=ASC(X$)
  122. 11090 FLD.CNT=FLD.CNT+1
  123. 11100 RETURN
  124. 11110 IF FLD.CNT > 20 GOTO 11170
  125. 11120 IF FLD.CNT = 19 THEN RANGE.BEG.ROW=ASC(X$): GOTO 11150
  126. 11130 R=ASC(X$): IF R>8 THEN R=8
  127. 11140 RANGE.BEG.ROW=RANGE.BEG.ROW+(R*256)
  128. 11150 FLD.CNT=FLD.CNT+1
  129. 11160 RETURN
  130. 11170 IF FLD.CNT > 22 GOTO 11210
  131. 11180 IF FLD.CNT = 21 THEN RANGE.END.COL=ASC(X$)
  132. 11190 FLD.CNT=FLD.CNT+1
  133. 11200 RETURN
  134. 11210 IF FLD.CNT > 24 GOTO 11400
  135. 11220 IF FLD.CNT = 23 THEN RANGE.END.ROW=ASC(X$): FLD.CNT=FLD.CNT+1: RETURN
  136. 11230 '       row must be 1-2048
  137. 11240 R=ASC(X$): IF R>8 THEN R=8
  138. 11250 RANGE.END.ROW=RANGE.END.ROW+(R*256)
  139. 11260 '
  140. 11270 ' Print range entry
  141. 11280 '
  142. 11290 IF RCNT=RMAX THEN PRINT "*** RANGE$ ARRAY EXCEEDED ***": END
  143. 11300 RCNT=RCNT+1
  144. 11310 PRINT USING "\              \";RANGE.NAME$;
  145. 11320 RANGE.BEG$=COL$(RANGE.BEG.COL)+MID$(STR$(RANGE.BEG.ROW+1),2)
  146. 11330 RANGE.END$=COL$(RANGE.END.COL)+MID$(STR$(RANGE.END.ROW+1),2)
  147. 11340 PRINT "   "RANGE.BEG$".."RANGE.END$"   ";
  148. 11350 IF RANGE.BEG.ROW>2047 OR RANGE.END.ROW>2047 THEN PRINT "*** Out of bounds ***" ELSE PRINT
  149. 11360 RANGE.NAME$=RANGE.NAME$+SPACE$(17-LEN(RANGE.NAME$))
  150. 11370 RANGE$(RCNT)=RANGE.NAME$+"  "+RANGE.BEG$+".."+RANGE.END$
  151. 11380 FLD.CNT=FLD.CNT+1: RANGE.NAME$=""
  152. 11390 RETURN
  153. 11400 IF X$<>LOTUS.CTL$(FLD.CNT-24) THEN END.OF.FILE=TRUE
  154. 11410 IF FLD.CNT < 28 THEN FLD.CNT=FLD.CNT+1 ELSE FLD.CNT=1
  155. 11420 RETURN
  156. 15000 '
  157. 15010 ' Error traps
  158. 15020 '
  159. 15030 IF ERR=57 THEN PRINT: PRINT "**** I/O Error         ****": END
  160. 15040 IF ERR<24 OR ERR>25 GOTO 15090
  161. 15050 IF ERL = 5210 THEN 15110
  162. 15060 IF ERL<>8060 GOTO 15140
  163. 15070 PRINT:PRINT "**** Check disk drive -- press any key to continue ****"
  164. 15080 CHA24 OR ERR>25 GOTO 15090
  165. 15050 IF ERL = 5210 THEN 15110
  166. 15060 IF ERL<>8060 GOTO 15140
  167. 15070 PRINT:PRINT "**** Check disk drive -- press any key to continue ****"
  168. 15080 CHAR$=INKEY$: IF CHAR$="" THEN 15070 ELSE RESUME
  169. 15090 '   Disk file open errors
  170. 15100 GOTO 15170
  171. 15110 '   Disk I/O errors
  172. 15120 IF ERR=62 OR ERR=63 THEN END.OF.FILE=TRUE: X$="": RESUME 8070
  173. 15130 GOTO 15170
  174. 15140 '
  175. 15150 PRINT:PRINT "**** Check printer -- press any key to continue ****"
  176. 15160 CHAR$=INKEY$: IF CHAR$="" THEN 15160 ELSE RESUME
  177. 15170 '
  178. 15180 IF ERR=6 THEN RESUME NEXT
  179. 15190 PRINT "ERROR #"ERR" IN LINE "ERL
  180. 15200 ON ERROR GOTO 0
  181. 16000 '
  182. 16010 ' List ranges to printer in columns
  183. 16020 '
  184. 16030 C1=1: C2=(RCNT+1)/2: RMAX=C2-1: LINE.CNT=99: PAGE.CNT=0
  185. 16040 IF LINE.CNT>56 THEN GOSUB 16150           ' Page heading
  186. 16050 LPRINT RANGE$(C1);
  187. 16060 X=LEN(RANGE$(C1)): LPRINT SPC(40-X);
  188. 16070 LPRINT RANGE$(C2)
  189. 16080 LINE.CNT=LINE.CNT+1
  190. 16090 IF C1<RMAX THEN C1=C1+1: C2=C2+1: GOTO 16040
  191. 16100 '                                           Finish report
  192. 16110 LPRINT:LPRINT
  193. 16120 LPRINT "< END OF LIST >"
  194. 16130 LPRINT CHR$(12)
  195. 16140 RETURN
  196. 16150 '
  197. 16160 ' Page overflow
  198. 16170 '
  199. 16180 LPRINT CHR$(12)                           ' top of form
  200. 16190 LINE.CNT=4: PAGE.CNT=PAGE.CNT+1
  201. 16200 LPRINT HEAD1$"  Page ";
  202. 16210 LPRINT USING "###";PAGE.CNT
  203. 16220 LPRINT HEAD2$
  204. 16230 LPRINT:LPRINT
  205. 16240 RETURN
  206. 60000 '
  207. 60010 ' Col Subscript
  208. 60020 '
  209. 60030 DATA A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z
  210. 60040 DATA AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR,AS,AT,AU,AV,AW,AX,AY,AZ
  211. 60050 DATA BA,BB,BC,BD,BE,BF,BG,BH,BI,BJ,BK,BL,BM,BN,BO,BP,BQ,BR,BS,BT,BU,BV,BW,BX,BY,BZ
  212. 60060 DATA CA,CB,CC,CD,CE,CF,CG,CH,CI,CJ,CK,CL,CM,CN,CO,CP,CQ,CR,CS,CT,CU,CV,CW,CX,CY,CZ
  213. 60070 DATA DA,DB,DC,DD,DE,DF,DG,DH,DI,DJ,DK,DL,DM,DN,DO,DP,DQ,DR,DS,DT,DU,DV,DW,DX,DY,DZ
  214. 60080 DATA EA,EB,EC,ED,EE,EF,EG,EH,EI,EJ,EK,EL,EM,EN,EO,EP,EQ,ER,ES,ET,EU,EV,EW,EX,EY,EZ
  215. 60090 DATA FA,FB,FC,FD,FE,FF,FG,FH,FI,FJ,FK,FL,FM,FN,FO,FP,FQ,FR,FS,FT,FU,FV,FW,FX,FY,FZ
  216. 60100 DATA GA,GB,GC,GD,GE,GF,GG,GH,GI,GJ,GK,GL,GM,GN,GO,GP,GQ,GR,GS,GT,GU,GV,GW,GX,GY,GZ
  217. 60110 DATA HA,HB,HC,HD,HE,HF,HG,HH,HI,HJ,HK,HL,HM,HN,HO,HP,HQ,HR,HS,HT,HU,HV,HW,HX,HY,HZ
  218. 60120 DATA IA,IB,IC,ID,IE,IF,IG,IH,II,IJ,IK,IL,IM,IN,IO,IP,IQ,IR,IS,IT,IU,IV
  219.